perm filename READX.F4[PAX,LCS] blob
sn#573423 filedate 1981-03-12 generic text, type T, neo UTF8
00100 COMMON /PTR/INP(72)
00200 DIMENSION FORM2(5),FORMT(5),NUMS(30)
00300 DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
00400 1, FORM3/'30I)'/
00450 IDEV=1
00500 1 FORMAT(72A1)
00600 CC IEXT='MS'
00700 CC ACCEPT 1,INP
00800 KEND=0
00900 C IDEV=DEVICE NUMBER (1=DSK, 5=TTY)
00950 CALL IFILE(1,'MVT2')
01000 99 READ(IDEV,1,END=12)INP
01100 DO 2 K=2,72
01200 IF(INP(K).EQ.' ')GO TO 3
01300 2 IF(INP(K).EQ.'.')GO TO 4
01400 3 FORMT(3)=FORM3
01500 FORMT(4)=' '
01600 FORMT(5)=' '
01700 5 FORMT(2)=FORM2(K-1)
01800 REREAD FORMT,NAME,NUMS
01900 GO TO 10
02000 4 FORMT(3)=FORM2(1)
02100 C CATCHES DOT
02200 DO 7 N=K+1,72
02300 7 IF(INP(N).EQ.' ')GO TO 8
02400 8 FORMT(4)=FORM2(N-K-1)
02500 FORMT(5)=FORM3
02600 FORMT(2)=FORM2(K-1)
02700 REREAD FORMT,NAME,K,IEXT,NUMS
02800 CALL LO2UP(IEXT)
02900 10 CALL LO2UP(NAME)
02925 100 FORMAT(1XA5,30I2)
02950 TYPE 100,NAME,NUMS
03000 GO TO 99
03100 12 KEND=-1
03200 END
03300
03400 SUBROUTINE LO2UP(J)
03500 C CONVERTS ALL LOWER CASE TO UPPER CASE.
03600 J=J.AND..NOT.((J/2).AND."201004020100)
03700 END
03800
03900 FUNCTION TSIG(Q,J)
04000 DIMENSION Q(1)
04100 TSIG=IFIX(Q(J+5)*100.0+Q(J+6)+.5)
04200 C COMBINES METER NUMS. (2/4 = 204. ETC.)
04300 END